home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / program / srcbkvt.zip / IMAGE.ASC < prev    next >
Text File  |  1996-07-08  |  11KB  |  317 lines
  1. _Image Processing and Visual Basic_
  2. by Don Parrish
  3.  
  4. Example 1:
  5.  
  6. Open Path$ For Binary As #1
  7.      Datarray$ = Input$(31680, #1)
  8.      Workarray$=Datarray$
  9. Close
  10.  
  11.  
  12. Example 2:
  13.      Open Path$ For Binary As #1
  14.      For Line = 1 To 165
  15.      For Point = 1 To 192
  16.           Position = Point + (Line - 1) * 192
  17.           Datarray$(Position) = INPUT(1,#1)
  18.      Next Point
  19.      Next Line
  20.      Close
  21.  
  22. Listing One
  23. Private Sub Form_Load()
  24.     Form1.WindowState = 2
  25.     Open_File
  26. End Sub
  27.  
  28. Private Sub Form_Paint()
  29.     'Call the plot routine
  30.         Plot_Image
  31. End Sub
  32.  
  33. Private Sub Normal_Histo_Click()
  34.     'If an error occurs, jump to error handling routine
  35.     On Error GoTo Normal_Histogram_ErrorHandler
  36.  
  37.     'Erase old histogram
  38.     Erase Histo_Array
  39.     Workarray$ = Datarray$
  40.  
  41.     'Change mouse pointer's shape
  42.     Screen.MousePointer = 11
  43.     'Calculate a histogram
  44.     For Datum = 1 To 31680
  45.         Number = Asc(Mid$(Datarray$, Datum, 1))
  46.         Histo_Array(Number) = Histo_Array(Number) + 1
  47.     Next Datum
  48.     'Enable the Stretch Histogram menu item
  49.      Stretch_Histo.Enabled = -1
  50.      Plot_Histogram
  51.      Plot_Image
  52.      Screen.MousePointer = 1
  53.      Exit Sub
  54.  
  55. Normal_Histogram_ErrorHandler:
  56.     
  57.     ' Define MSGBOX variables
  58.     Msg = "Enter a larger value!"
  59.     DgDef = MB_OK + MB_ICONSTOP
  60.     Title = "Process Error"
  61.     ' Put together a message box with all the proper components
  62.     MsgBox Msg, DgDef, Title
  63.     Save_BMP_File.Enabled = 0
  64.     Resume Normal_Histo_Ended
  65.  
  66. Normal_Histo_Ended:
  67.       Screen.MousePointer = 1
  68.        Plot_Image
  69. End Sub
  70.  
  71. Private Sub OpenFile_Click()
  72.     'Call the open file routine
  73.     Open_File
  74. End Sub
  75.  
  76. Private Sub Quit_Program_Click()
  77.     End
  78. End Sub
  79.  
  80. Private Sub Save_File_Click()
  81.     'If an error occurs, jump to error handling routine
  82.     On Error GoTo ErrorHandler
  83.     'Get path and name of file from the user
  84.     Path$ = InputBox$("Enter path and file name." & Chr$(10) & Chr$(10) & 
  85.                    Chr$(10) & "If you want to exit," & Chr$(10) & 
  86.                    Chr$(10) & "press Escape" & 
  87.                    Chr$(10) & "or click on Cancel.", "SAVE FILE", "C:\VB\")
  88.     'Retrieve data from the file into an array
  89.     Open Path$ For Binary As #1
  90.     Put #1, , Workarray$
  91.     Close #1
  92.     'This task is completed
  93.     Exit Sub
  94. 'Error handling routine reports an error happened
  95. ErrorHandler:
  96.     ' Define MSGBOX variables
  97.     Msg = "Did NOT save!"
  98.     DgDef = MB_OK + MB_ICONSTOP
  99.     Title = "I/O Error"
  100.     ' Put together a message box with all the proper components
  101.     MsgBox Msg, DgDef, Title
  102.     Resume Normal_Histo_Completed
  103. Normal_Histo_Completed:
  104. End Sub
  105.  
  106. Private Sub Stretch_Histo_Click()
  107.     ' Declare variables
  108.     Dim Answer, DefVal, Msg, Title
  109.     'Prompt user to input lower boundary
  110.     Msg = "Enter a lower boundary value from 0 to 253."  ' Set prompt.
  111.     Title = "Stretch Hitsogram Lower Limit" ' Set title.
  112.     DefVal = "0"    ' Set default return value.
  113.     'Insure user answers within limits
  114.     Do
  115.         Answer1 = InputBox(Msg, Title, DefVal)   ' Get user input.
  116.     Loop Until Answer1 >= 0 And Answer1 <= 253
  117.     'Tell user what was entered
  118.     MsgBox "You entered " & Chr$(10) & Chr$(10) & Answer1 ' Display message.
  119.     Lower_Limit = Answer1
  120.     'Prompt user to input upper boundary
  121.     Msg = "Enter an upper boundary value greater than" & Chr$(10) & 
  122.                                     Chr$(10) & Lower_Limit ' Set prompt.
  123.     Title = "Stretch Hitsogram Upper Limit" ' Set title.
  124.     DefVal = "255"    ' Set default return value.
  125.     'Insure user answers within limits
  126.     Do
  127.         Answer2 = InputBox(Msg, Title, DefVal)   ' Get user input.
  128.     Loop Until Answer2 >= Val(Answer1) And Answer2 <= 256
  129.     'Tell user what was entered
  130.     MsgBox "You entered " & Chr$(10) & Chr$(10) & Answer2 ' Display message.
  131.     Upper_Limit = Answer2
  132.     'Setup for the histogram plot
  133.     Dim DisplayLevel, HistoPlotLevel
  134.     LoRange = Val(Lower_Limit)
  135.     HiRange = Val(Upper_Limit)
  136.     Screen.MousePointer = 11
  137.     'Clear the old histogram plot
  138.     Erase Histo_Array
  139.     'Calculate the histogram
  140.       For Lines = 1 To 165
  141.         For Points = 1 To 192
  142.             Level = Asc(Mid$(Datarray$, Points + (Lines - 1) * 192, 1))
  143.             Brightness = CInt((Level - LoRange) / (HiRange - LoRange) * 256)
  144.             If Brightness < 0 Then Brightness = 0
  145.             If Brightness > 255 Then Brightness = 255
  146.             Mid$(Workarray$, Points + (Lines - 1) * 192, 1) = Chr$(Brightness)
  147.             Histo_Array(Brightness) = Histo_Array(Brightness) + 1
  148.         Next Points
  149.       Next Lines
  150.     'Call plot routines for the histogram and image
  151.     Plot_Histogram
  152.     Plot_Image
  153.     'Change the mouse pointer shape
  154.     Screen.MousePointer = 0
  155.     'Inhibit selection of STRETCH from the drop-down menu
  156.     Normal_Histo.Enabled = -1
  157.     Stretch_Histo.Enabled = 0
  158.   Exit Sub
  159.  
  160.     'Setup error routine
  161. ERROR_HistoStretch_MESSAGE:
  162.     MsgBox "Values Out of Range.  Enter New Values.", 0, "ERROR MESSAGE"
  163.     Resume ERROR_HistoStretch_HANDLER
  164.  
  165. ERROR_HistoStretch_HANDLER:
  166.     Screen.MousePointer = 0
  167. End Sub
  168.  
  169. Private Sub Zoom_Image_In_Click()
  170.     'Declare variable
  171.     Dim SuccessFlag
  172.     'Use raster operations to double the size of the image
  173.     'located in the left hand corner of the window
  174.     If Zoom_Check = 0 Then
  175.         'Double image size beginning from upper left corner of the original
  176.         SuccessFlag = StretchBlt(Form1.hDC, 0, 0, 384, 330, Form1.hDC, 0, 0, 
  177.                                                            192, 165, &HCC0020)
  178.         'Set a flag if this is done first
  179.         Zoom_Check = 1
  180.         Else
  181.         'Double image size beginning from an offset equal in size to original 
  182.         SuccessFlag = StretchBlt(Form1.hDC, 0, 0, 384, 330, Form1.hDC, 48, 
  183.                                                         41, 240, 206, &HCC0020)
  184.     End If
  185. End Sub
  186.  
  187. Private Sub Zoom_Image_Out_Click()
  188.     'A safe way to downsize the image is to redraw it
  189.     Plot_Image
  190. End Sub
  191.  
  192.  
  193. Listing Two
  194. 'Declarations of variables that may be accessed by any program function
  195. Global Datarray As String, Workarray As String
  196. Global Histo_Array(255) As Integer
  197. Global Zoom_Check As Integer
  198.  
  199. 'Windows API function calls
  200. Declare Function CreateBitmapByString% Lib "GDI" Alias "CreateBitmap" (ByVal 
  201.       nWidth%, ByVal nHeight%, ByVal nPlanes%, ByVal nBitCount%, ByVal lpBits$)
  202. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  203. Declare Function CreateCompatibleBitmap% Lib "GDI" (ByVal hDC%, 
  204.                                                  ByVal nWidth%, ByVal nHeight%)
  205. Declare Function CreateCompatibleDC% Lib "GDI" (ByVal hDC%)
  206. Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%,ByVal x%,ByVal y%,ByVal 
  207.      nWidth%,ByVal nHeight%,ByVal hSrcDC%,ByVal XSrc%,ByVal YSrc%,ByVal dwRop&)
  208. Declare Function StretchBlt% Lib "GDI" (ByVal hDC%,ByVal x%,ByVal y%,ByVal 
  209.     nWidth%,ByVal nHeight%,ByVal hSrcDC%,ByVal XSrc%,ByVal YSrc%,
  210.     ByVal nSrcWidth%,ByVal nSrcHeight%,ByVal dwRop&)
  211. 'Constants and variables used in error handlers
  212. Global Const MB_OK = 0       ' Define button
  213. Global Const MB_ICONSTOP = 16      ' Define Icon
  214. Global Msg, DgDef, Title    ' Declare variables
  215.  
  216. 'Routine used to open files
  217.     'Initialize error handler
  218.     On Error GoTo ErrorHandler_Input
  219.         'Get file path from the user
  220.         Path$ = InputBox$("Enter path and file name" & Chr$(10) & Chr$(10) & 
  221.            Chr$(10) & "If you want to exit,"& Chr$(10) & Chr$(10) & "Press 
  222.            Escape" & Chr$(10) & "or click on Cancel.", "OPEN FILE", "C:\VB\")
  223.         'Load data from a file and put into strings
  224.         Open Path$ For Binary As #1
  225.             Datarray$ = Input$(31680, #1)
  226.             Workarray$ = Datarray$
  227.         Close
  228.         'Clean up the form before plotting the image
  229.         Form1.Picture1.Cls
  230.         Form1.Cls
  231.         'Set flags
  232.         Form1.Save_BMP_File.Enabled = -1
  233.         Form1.Stretch_Histo.Enabled = 0
  234.         Form1.Normal_Histo.Enabled = -1
  235.         'Plot the image
  236.